home *** CD-ROM | disk | FTP | other *** search
/ Magnum One / Magnum One (Mid-American Digital) (Disc Manufacturing).iso / d12 / ddj0290.arc / CANUP.LST < prev    next >
File List  |  1990-01-07  |  12KB  |  426 lines
  1. _PICK-A-NUMBER INTERFACES_
  2. by Bob Canup
  3.  
  4. [LISTING ONE]
  5.  
  6. MODULE Mtest ;
  7. FROM MENU IMPORT MenuType,Menu ;
  8. FROM InOut IMPORT WriteString, WriteLn ;
  9. PROCEDURE CLS ;
  10. BEGIN
  11.     WriteString(CHR(12)) ;
  12. END CLS ;
  13.  
  14. PROCEDURE Header ;
  15. BEGIN
  16.     WriteLn ;
  17.     WriteLn ;
  18.     WriteLn ;
  19.     WriteLn ;
  20.     WriteString('                     M A I L I N G   L I S T   M E N U') ;
  21.     WriteLn ;
  22.     WriteString('                      (Press Esc key to leave progam)') ;
  23. END Header ;
  24.  
  25. PROCEDURE EnterData ;
  26. END EnterData ;
  27. PROCEDURE PrintZip ;
  28. END PrintZip ;
  29. PROCEDURE Modify ;
  30. END Modify ;
  31. PROCEDURE DelData ;
  32. END DelData ;
  33. PROCEDURE Browse ;
  34. END Browse ;
  35. PROCEDURE Backup ;
  36. END Backup ;
  37. PROCEDURE PrintNZip ;
  38. END PrintNZip ;
  39. PROCEDURE Setup ;
  40. END Setup ;
  41. PROCEDURE test ;
  42. VAR
  43.     test    : MenuType ;
  44.     i    : CARDINAL ;
  45. BEGIN
  46.     LOOP    
  47.         CLS ;
  48.         Header ;
  49.         test[0] := '1. Enter new mail list data.' ;
  50.         test[1] := '2. Print a Zip code sorted mail list.' ;
  51.         test[2] := '3. Change existing data.' ;
  52.         test[3] := '4. Delete a single address from the list.' ;
  53.         test[4] := '5. Browse through the existing data.' ;
  54.         test[5] := '6. Backup data.' ;
  55.         test[6] := '7. Print a mail list not sorted by ZIP.' ;
  56.         test[7] := '8. Perform other functions.' ;
  57.         i := Menu(test,8) ;
  58.         CASE i OF
  59.             0 : EXIT      |
  60.             1 : EnterData |
  61.             2 : PrintZip  |
  62.             3 : Modify    |
  63.             4 : DelData   |
  64.             5 : Browse    |
  65.             6 : Backup    |
  66.             7 : PrintNZip |
  67.             8 : Setup     
  68.         END ; (* CASE *)
  69.     END ; (* LOOP *)
  70. END test ;
  71. BEGIN
  72.     test ;
  73. END Mtest.
  74.  
  75.  
  76. [LISTIN╟ TWO]
  77.  
  78. DEFINITION MODULE READA;
  79. (* EscType determines whether an esc will exit a field. The values are:
  80.     Esc   which allows an escape to exit a field. 
  81.     NoEsc which prevents exit from a field on an escape char entry.
  82. *)
  83. FROM SYSTEM IMPORT AX,BX,CX,DX,BP,CODE,SETREG ;
  84. FROM Terminal IMPORT Write ; 
  85. FROM InOut IMPORT EOL ; 
  86.     EXPORT QUALIFIED Grab, ClearField, gotoxy, EscType ;
  87. TYPE
  88.      EscType = (Esc,NoEsc) ;
  89.      PROCEDURE Grab(VAR String : ARRAY OF CHAR ; EscFlag :EscType) ;
  90.      PROCEDURE ClearField(VAR String : ARRAY OF CHAR ; Column,Row : CARDINAL);
  91.      PROCEDURE gotoxy(x,y : CARDINAL ) ;
  92. END READA.
  93.  
  94.  
  95. [LISTING THREE]
  96.  
  97. (***************************************************************************
  98.      Name: READA
  99.     Purpose: Usefull String routines
  100.         ClearField wipes out a data entry field on screen 
  101.         Grab accepts characters up to length of length of string array
  102.         then refuses to accept any more chars until Enter is pressed.
  103.         gotoxy positions the cursor.
  104.     Entry: ClearField(VAR String: ARRAY OF CHAR ; Column,Row : CARDINAL)
  105.            Grab(VAR String:ARRAY OF CHAR ; EscFlag : EscType)
  106.            gotoxy(x,y : CARDINAL) x = column y = row.
  107.     Exit: ClearField - String is zeroed, cursor left at position Column,Row
  108.           Grab - String is filled in with user entered characters. 
  109.     Global Variables used: Passed String array.
  110.     Revision number:
  111.     1.2   10/3/88   Escape type added to Grab.
  112.     1.1   11/30/87  Escape key exit for String 0.
  113.     1.0   11/8/87
  114. ****************************************************************************)
  115.  
  116. IMPLEMENTATION MODULE READA ;
  117. FROM SYSTEM IMPORT AX,BX,CX,DX,BP,CODE,SETREG ;
  118. FROM Terminal IMPORT Write, Read ;
  119. FROM InOut IMPORT EOL ;
  120. VAR
  121.     Index    : CARDINAL ;
  122.     Ch    : CHAR ;
  123. PROCEDURE gotoxy(x,y : CARDINAL ) ;
  124. VAR
  125.     a : CARDINAL ;
  126. BEGIN
  127.     IF ( x >= 0) AND ( x <= 79) AND ( y >=0) AND ( y <=24) THEN
  128.         IF ( x # 79) OR (y # 24 )
  129.         THEN
  130.         CODE( 55H) ;        (* PUSH BP *)
  131.         a := 200H ;
  132.         SETREG ( AX ,a ) ;
  133.         CODE( 50H ) ;        (* PUSH AX *)
  134.         a := 0H ;
  135.         SETREG( BX , a) ;
  136.         CODE( 53H) ;        (* PUSH BX *)
  137.         SETREG( DX,x + 256 * y) ;
  138.         CODE( 5BH ) ;        (* POP BX *)
  139.         CODE( 58H ) ;        (* POP AX *)
  140.         CODE( 0CDH,10H) ;    (* INT 10H *)
  141.         CODE( 5DH ) ;        (* POP BP *)
  142.         END ;
  143.     END ;
  144. END gotoxy ;
  145.  
  146. PROCEDURE ClearField(VAR String : ARRAY OF CHAR ; Column,Row : CARDINAL) ;
  147. (* This procedure wipes the appropriate field on the screen out *)
  148. BEGIN
  149.     gotoxy(Column,Row) ;    (* Position Cursor *)
  150.     FOR Index := 0 TO HIGH(String) DO
  151.         Write(' ') ;
  152.     END ;    (* FOR *)
  153.     gotoxy(Column,Row) ;    (* Reposition Cursor *)
  154. END ClearField ;
  155.  
  156. PROCEDURE Grab(VAR String : ARRAY OF CHAR ; EscFlag : EscType ) ;
  157.  
  158. (* This procedure assumes that the cursor has already been moved to a position
  159. either by a direct gotoxy call or by a call to ClearField *)
  160.  
  161. BEGIN
  162.     FOR Index := 0 TO HIGH(String) DO
  163.         String[Index] := CHR(0) ;
  164.     END ; (* FOR *)
  165.     Index := 0 ;
  166.     LOOP
  167.         Read(Ch) ;
  168.         IF Ch = EOL THEN EXIT END ;
  169.         IF EscFlag = Esc THEN
  170.             IF Ch = CHR(27) THEN
  171.                 String[0] := Ch ;
  172.                 EXIT ;
  173.             END ;
  174.         END ;
  175.         IF Ch = CHR(8) THEN
  176.             IF Index = 0 THEN
  177.                 Write(CHR(7)) ;    (* Honk at Barney *)
  178.             ELSE
  179.                 Write(CHR(8)) ;    (* BackSpace *)
  180.                 Write(CHR(32)) ;    (* Space *)
  181.                 Write(CHR(8)) ;    (* BackSpace *)
  182.                 Index := Index - 1 ;
  183.                 String[Index] := CHR(0) ;
  184.             END ; (* IF *)
  185.         ELSIF Ch < CHR(32) THEN
  186.             Write(CHR(7)) ;    (* Honk at Barney *)
  187.         ELSE
  188.             IF Index = (HIGH(String) +1) THEN
  189.                 Write(CHR(7)) ;
  190.             ELSE
  191.                 String[Index] := Ch ;
  192.                 Write(Ch) ;
  193.                 Index := Index + 1 ;
  194.             END ; (* IF *)
  195.         END ; (* IF *)
  196.     END ; (* LOOP *)
  197. END Grab ;
  198. END READA .
  199.  
  200.  
  201. [LISTIN╟ FOUR]
  202.  
  203. DEFINITION MODULE MENU ;
  204.   EXPORT QUALIFIED MenuType,Menu ;
  205.   TYPE MenuType = ARRAY[0..59],[0..79] OF CHAR ;
  206.   PROCEDURE Menu(VAR A : MenuType ; NumberOfMenuEntries : CARDINAL) :CARDINAL ;
  207. END MENU.
  208.  
  209.     
  210.  
  211. [LISTING FIVE]
  212.  
  213. (**************************************************************************
  214. Name: MENU
  215. Purpose: Automatic screen layout, and response error checking for
  216.    Pick-a-number menus.
  217. Entry: Menu(VAR A : MenuType ; NumberOfMenuEntries : CARDINAL): CARDINAL ;
  218. Exit: Qualified acceptance of menu item or escape key.
  219. Revision Number:
  220. 1.1   10/3/88 Escape key output changed to = 0
  221. 1.0   9/26/88
  222. ***************************************************************************)
  223.  
  224. IMPLEMENTATION MODULE MENU ;
  225. FROM READA IMPORT gotoxy, Grab,EscType ;
  226. FROM Strings IMPORT Length ;
  227. FROM NumberConversion IMPORT StringToCard ;
  228. FROM InOut IMPORT WriteString ;
  229.  
  230. PROCEDURE OneColumn(VAR A : MenuType ; i : CARDINAL) ;
  231. VAR
  232.     j,k,l,m : CARDINAL ;
  233. BEGIN
  234.     i := i - 1 ; (* Convert from one base to zero based *)
  235.     (* First we center the strings to be displayed vertically *)
  236.     j := (5 + ((15 - i) DIV 2)) ;
  237.     (* Now we center the strings horizontally *)
  238.     l := 0 ;
  239.     FOR m := 0  TO i DO
  240.         k := Length(A[m]) ;
  241.         IF (k > l) THEN l := k END ; (* get longest string length *)
  242.     END ; (* FOR *)
  243.     k := (40 -(l DIV 2)) ;
  244.     
  245.     (* Now print the menu *) 
  246.     FOR m := 0 TO i DO
  247.         gotoxy(k,(j+m)) ; (* Position cursor to string position *)
  248.         WriteString(A[m]) ;
  249.     END ; (* FOR *)
  250. END OneColumn ;
  251.  
  252. PROCEDURE TwoColumns(VAR A : MenuType ; i : CARDINAL) ;
  253. VAR
  254.     j,k,l,m,n,o,p : CARDINAL ;
  255. BEGIN
  256.     (* First we center the strings to be displayed vertically *)
  257.     i := i - 1 ;    (* Convert from one base to zero based *)
  258.     n := i DIV 2 ;
  259.     j := (5 + ((15 - n) DIV 2)) ;
  260.     (* Now we center the strings horizontally *)
  261.     l := 0 ;
  262.     FOR m := 0  TO n-1 DO
  263.         k := Length(A[m]) ;
  264.         IF (k > l) THEN l := k END ; (* get longest string length *)
  265.     END ; (* FOR *)
  266.     k := (20 -(l DIV 2)) ;
  267. (* Now set up the second column centered on position 60 *)
  268.     o := 0 ;
  269.     FOR m := n   TO i DO
  270.         p := Length(A[m]) ;
  271.         IF (p > o) THEN o := p END ; (* get longest string length *)
  272.     END ; (* FOR *)
  273.     p := (60 -(o DIV 2)) ;
  274.     
  275.     (* Now print the menu *) 
  276.     FOR m := 0 TO n-1 DO
  277.         gotoxy(k,(j+m)) ; (* Position cursor to string position *)
  278.         WriteString(A[m]) ;
  279.     END ; (* FOR *)
  280.     FOR m := n TO i DO
  281.         gotoxy(p,(j+m-(n))) ; (* Position cursor to string position *)
  282.         WriteString(A[m]) ;
  283.     END ; (* FOR *)
  284.  
  285. END TwoColumns ;
  286.  
  287. PROCEDURE ThreeColumns(VAR A : MenuType ; i : CARDINAL) ;
  288. VAR
  289.     j,k,l,m,n,o,p,q,r : CARDINAL ;
  290. BEGIN
  291.     (* First we center the strings to be displayed vertically *)
  292.     i := i - 1 ;    (* Convert from one base to zero based *)
  293.     n := i DIV 3 ;
  294.     j := i MOD 3 ;
  295.     IF j = 2 THEN INC(n) END ;
  296.     j := (5 + ((15 - n) DIV 2)) ;
  297.     (* Now we center the strings horizontally *)
  298.     l := 0 ;
  299.     FOR m := 0  TO n-1 DO
  300.         k := Length(A[m]) ;
  301.         IF (k > l) THEN l := k END ; (* get longest string length *)
  302.     END ; (* FOR *)
  303.     k := (20 -(l DIV 2)) ;
  304. (* Now set up the second column centered on position 40 *)
  305.     o := 0 ;
  306.     FOR m := n  TO (2*n)-1 DO
  307.         p := Length(A[m]) ;
  308.         IF (p > o) THEN o := p END ; (* get longest string length *)
  309.     END ; (* FOR *)
  310.     p := (40 -(o DIV 2)) ;
  311. (* Now set up the third column centered on position 60 *)
  312.     q := 0 ;
  313.     FOR m := 2*n   TO i DO
  314.         r := Length(A[m]) ;
  315.         IF (r > q) THEN q := r END ; (* get longest string length *)
  316.     END ; (* FOR *)
  317.     r := (60 -(q DIV 2)) ;
  318.     
  319.     (* Now print the menu *) 
  320.     FOR m := 0 TO n-1 DO
  321.         gotoxy(k,(j+m)) ; (* Position cursor to string position *)
  322.         WriteString(A[m]) ;
  323.     END ; (* FOR *)
  324.     FOR m := n TO 2*n-1 DO
  325.         gotoxy(p,(j+m-n)) ; (* Position cursor to string position *)
  326.         WriteString(A[m]) ;
  327.     END ; (* FOR *)
  328.     FOR m := 2*n TO i DO
  329.         gotoxy(r,(j+m-2*n)) ; (* Position cursor to string position *)
  330.         WriteString(A[m]) ;
  331.     END ; (* FOR *)
  332. END ThreeColumns ;
  333.         
  334. PROCEDURE FourColumns(VAR A : MenuType ; i : CARDINAL) ;
  335. VAR
  336.     j,k,l,m,n,o,p,q,r,s,t : CARDINAL ;
  337. BEGIN
  338.     (* First we center the strings to be displayed vertically *)
  339.     i := i - 1 ;    (* Convert from one base to zero based *)
  340.     n := i DIV 4 ;
  341.     j := i MOD 4 ;
  342.     IF j = 3 THEN INC(n) END ;
  343.     j := (5 + ((15 - n) DIV 2)) ;
  344.     (* Now we center the strings horizontally *)
  345.     l := 0 ;
  346.     FOR m := 0  TO n-1 DO
  347.         k := Length(A[m]) ;
  348.         IF (k > l) THEN l := k END ; (* get longest string length *)
  349.     END ; (* FOR *)
  350.     k := (16 -(l DIV 2)) ;
  351. (* Now set up the second column centered on position 40 *)
  352.     o := 0 ;
  353.     FOR m := n   TO 2*n-1 DO
  354.         p := Length(A[m]) ;
  355.         IF (p > o) THEN o := p END ; (* get longest string length *)
  356.     END ; (* FOR *)
  357.     p := (32 -(o DIV 2)) ;
  358. (* Now set up the third column centered on position 60 *)
  359.     q := 0 ;
  360.     FOR m := 2*n   TO 3*n-1 DO
  361.         r := Length(A[m]) ;
  362.         IF (r > q) THEN q := r END ; (* get longest string length *)
  363.     END ; (* FOR *)
  364.     r := (48 -(q DIV 2)) ;
  365.     s := 0 ;
  366.     FOR m := 3*n   TO i DO
  367.         t := Length(A[m]) ;
  368.         IF (t > s) THEN s := t END ; (* get longest string length *)
  369.     END ; (* FOR *)
  370.     t := (64 -(s DIV 2)) ;
  371.     
  372.     (* Now print the menu *) 
  373.     FOR m := 0 TO n-1 DO
  374.         gotoxy(k,(j+m)) ; (* Position cursor to string position *)
  375.         WriteString(A[m]) ;
  376.     END ; (* FOR *)
  377.     FOR m := n TO 2*n-1 DO
  378.         gotoxy(p,(j+m-(n))) ; (* Position cursor to string position *)
  379.         WriteString(A[m]) ;
  380.     END ; (* FOR *)
  381.     FOR m := 2*n TO 3*n-1 DO
  382.         gotoxy(r,(j+m-(2*n))) ; (* Position cursor to string position *)
  383.         WriteString(A[m]) ;
  384.     END ; (* FOR *)
  385.     FOR m := 3*n TO i DO
  386.         gotoxy(t,(j+m-(3*n))) ; (* Position cursor to string position *)
  387.         WriteString(A[m]) ;
  388.     END ; (* FOR *)
  389. END FourColumns ;
  390.  
  391. PROCEDURE Menu(VAR A : MenuType ; NumberOfMenuEntries : CARDINAL): CARDINAL ;
  392. VAR
  393.     i,j,k,l    : CARDINAL ;
  394.     input    : ARRAY[0..1] OF CHAR ;
  395.     done    : BOOLEAN ;
  396. BEGIN
  397. (* 'A' is actually an array of character strings ( an array of array of char)
  398. Menu displays 'A' and waits for up to a two character response with a trailing
  399. carriage return. Menu returns 100 if escape is pressed, otherwise returns 
  400. number entered by user as menu response.(0..60).
  401. *)
  402.     i := NumberOfMenuEntries ;
  403.     IF (i <= 15 ) THEN OneColumn(A,i) END ; 
  404.     IF ((i > 15) AND (i <= 30)) THEN TwoColumns(A,i) END ; 
  405.     IF ((i > 30) AND (i <= 45 )) THEN ThreeColumns(A,i) END ;
  406.     IF (i > 45) THEN FourColumns(A,i) END ;
  407.     (* Allow a maximum of 15 items per column on displayed menu.*)
  408.   LOOP
  409.     gotoxy(5,24) ;
  410.     WriteString('Enter the number of your selection and press Enter key:   ') ;
  411.     WriteString(CHR(08)) ;
  412.     WriteString(CHR(08)) ;
  413.     Grab(input,Esc) ;
  414. (* If Esc is pressed instead of a number exit with an impossible  value *)
  415.         IF (input[0] = CHR(27)) THEN RETURN 0 END ;
  416.         StringToCard(input,j,done) ;
  417. (* Return only legal values of input *)
  418.         IF done THEN 
  419.             IF (j > 0) AND ( j <=i) THEN RETURN j END ;
  420.         END ; (* IF *)
  421.     END ; (* LOOP *)
  422. END Menu ;
  423. END MENU .
  424.  
  425.  
  426.